home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / bbsutil / dlx70bbs.zip / DLX70SRC.ZIP / XMODEM.PAS < prev   
Pascal/Delphi Source File  |  1994-01-19  |  16KB  |  447 lines
  1. {$debug-}
  2. {$line-}
  3.  
  4. {$include: 'types.int'}
  5. {$include: 'globals.int'}
  6. {$include: 'utils.int'}
  7. {$include: 'xmodem.int'}
  8.  
  9. IMPLEMENTATION OF xmodem;
  10.  
  11. USES types,globals,utils;
  12.  
  13. {DLX Bulletin Board System V7.0
  14.  
  15.  FREEWARE NOTICE
  16.  
  17.  DLX V7.0 is placed in the public domain by its author, Richard Gillmann.
  18.  Anyone who wishes to may run the program, copy it, or modify it for
  19.  any purpose, including commercial gain.}
  20.  
  21. {***INTERFACE TO THE PASASM ASSEMBLER UTILITIES PACKAGE***}
  22. {$include: 'pasasm.int'}
  23.  
  24. {***INTERFACE TO THE COM_PAX2 ASYNCHRONOUS COMMUNICATIONS PACKAGE***}
  25. {$include: 'com_pax2.int'}
  26.  
  27. {***Interface to MS Pascal library***}
  28. function allmqq(wants : word) : adsmem; EXTERN;
  29.  
  30. const
  31.   soh = chr(16#01); {Ctrl-A = start of 128 byte block}
  32.   stx = chr(16#02); {Ctrl-B = start of 1024 byte block}
  33.   eot = chr(16#04); {Ctrl-D = end of transmit}
  34.   ack = chr(16#06); {Ctrl-F = acknowledge}
  35.   bs  = chr(16#08); {Ctrl-H = backspace}
  36.   nak = chr(16#15); {Ctrl-U = negative acknowledge}
  37.   can = chr(16#18); {Ctrl-X = cancel}
  38.   ctrl_z = chr(16#1A); {MS DOS end of file marker}
  39.   filler = ctrl_z; {use this character to pad out short blocks}
  40.   max_errs = 20; {this many protocol errors -> cancel the thing}
  41.  
  42. function newbpara {bpara};
  43. var
  44.   b : bpara;
  45. begin
  46.   if bavail<>RETYPE(bpara,nill) then
  47.     [newbpara:=bavail; bavail:=bavail^.link]
  48.   else
  49.     [b:=allmqq(sizeof(bavail^)); {don't fail if no mem}
  50.      if b.r<=1
  51.        then b:=RETYPE(bpara,nill)
  52.        else lhc:=lhc+sizeof(bavail^)+2;
  53.      newbpara:=b];
  54. end {newbpara};
  55.  
  56. procedure disbpara{b : bpara};
  57. begin
  58.   b^.link:=bavail;
  59.   bavail:=b;
  60. end {disbpara};
  61.  
  62. procedure cancel;
  63. begin
  64.   send(can);
  65.   send(can);
  66.   send(can);
  67.   send(bs);
  68.   send(bs);
  69.   send(bs);
  70. end {cancel};
  71.  
  72. {Called from cleanup code, in case user hangs up during a transfer.
  73.  Only called when state2<>0}
  74. procedure xcancel;
  75. var
  76.   str : lstring(64);
  77. begin
  78.   if q[wx].handle>0 then
  79.     [if q[wx].bflag {downloading} then
  80.        mail_close(q[wx].handle)
  81.      else
  82.        [copylst(q[wx].pathname,str); concat(str,'\');
  83.         konkat(str,q[wx].filename); mail_delete(str)]];
  84.   q[wx].handle:=0;
  85.   if w^[wx].file_locked<>nill then w^[wx].file_locked^.msg:=null;
  86.   binary_mode(0);
  87.   w^[wx].strx:=null;
  88. end {xcancel};
  89.  
  90. {THE SENDER}
  91. procedure xtransmit; {download from board to caller}
  92. var
  93.   next_state2 : integer;
  94.   str : lstring(64);
  95.   i,j : integer;
  96.   chksum : word;
  97.   i4 : integer4;
  98.   flag : boolean;
  99. begin
  100.   next_state2:=q[wx].state2+1;
  101.   case q[wx].state2 of
  102. {open the file we're going to send}
  103.     1 : [binary_mode(1);
  104.          q[wx].count4:=0; q[wx].index:=0; q[wx].count:=0; q[wx].dos_err:=0;
  105.          copylst(q[wx].pathname,str); concat(str,'\');
  106.          concat(str,q[wx].filename);
  107.          {file locking done before we get here}
  108.          if (q[wx].xfermode and f128)<>0 then
  109.            [w^[wx].strx.len:=128;
  110.             fillsc(ads w^[wx].strx[1],128,filler)]
  111.          else
  112.            fillsc(ads q[wx].buffer^.data[1],1024,filler);
  113.          q[wx].handle:=xopen(0,str);
  114.          if q[wx].handle<=0 then
  115.            [q[wx].flag:=false; q[wx].count:=-q[wx].handle;
  116.             q[wx].dos_err:=-q[wx].handle; q[wx].handle:=0; next_state2:=665];
  117.          w^[wx].clock_target:=jt];
  118. {wait for command from receiver}
  119.     2 : [i4:=jt-w^[wx].clock_target;
  120.          if i4<0 then i4:=i4+one_day;
  121.          if i4>60 then
  122.            [q[wx].flag:=false; q[wx].count:=0; next_state2:=665]
  123.          else if r_count=0 then
  124.            next_state2:=2];
  125. {looking for nak or C or G to begin download}
  126.     3 : case receive of
  127.           can : {cancel}
  128.                 [q[wx].flag:=false; q[wx].count:=0; next_state2:=665];
  129.           nak : {please send block w/checksum}
  130.                 [q[wx].xfermode := q[wx].xfermode and (not fCrc);
  131.                  next_state2:=6];
  132.           'C' : {please send block w/CRC}
  133.                 [q[wx].xfermode := q[wx].xfermode or fCrc;
  134.              next_state2:=6];
  135.       'G' : {please send block w/CRC and don't expect an ack in response}
  136.                 [q[wx].xfermode := q[wx].xfermode or fCrc or fNak;
  137.                  next_state2:=6];
  138.           otherwise next_state2:=2;
  139.         end {case};
  140. {wait for response to end of transmission}
  141.     4 : [i4:=jt-w^[wx].clock_target;
  142.          if i4<0 then i4:=i4+one_day;
  143.          if i4>60 then
  144.            [q[wx].flag:=false; q[wx].count:=0; next_state2:=665]
  145.          else if r_count=0 then
  146.            next_state2:=4];
  147. {looking for ack}
  148.     5 : case receive of
  149.           can : [q[wx].flag:=false; q[wx].count:=0; next_state2:=665];
  150.           ack : [q[wx].flag:=true; q[wx].count:=0; next_state2:=665];
  151.           nak,'C' : [while r_count>0 do eval(receive);
  152.                      send(eot);
  153.                      next_state2:=4];
  154.           otherwise next_state2:=4;
  155.         end {case};
  156. {read next packet's data from file}
  157.     6 : [q[wx].index:=(q[wx].index+1) mod 256;
  158.          if (q[wx].xfermode and f128)<>0 then
  159.            [w^[wx].strx.len:=128;
  160.             fillsc(ads w^[wx].strx[1],128,filler);
  161.         i:=xread(q[wx].handle,ads w^[wx].strx[1],128)]
  162.          else
  163.            [fillsc(ads q[wx].buffer^.data[1],1024,filler);
  164.         i:=xread(q[wx].handle,ads q[wx].buffer^.data[1],1024)];
  165.          if i<0 then
  166.            [q[wx].flag:=false; q[wx].count:=-i; q[wx].dos_err:=-i;
  167.             next_state2:=665]
  168.          else if i=0 then {end of file}
  169.            [send(eot);
  170.             w^[wx].clock_target:=jt; next_state2:=4]
  171.          else
  172.            q[wx].bindex:=0];
  173. {send packet header}
  174.     7 : [if (q[wx].xfermode and f128)<>0 then
  175.            send(soh)
  176.          else
  177.            send(stx);
  178.          send(chr(q[wx].index));
  179.          send(chr(255-q[wx].index));
  180.          q[wx].crc:=0];
  181. {send packet data}
  182.     8 : if (q[wx].xfermode and f128)<>0 then
  183.           [chksum:=0;
  184.            for i:=1 to 128 do
  185.              [send(w^[wx].strx[i]);
  186.               if (q[wx].xfermode and fCrc)<>0
  187.                 then crc_16(w^[wx].strx[i],chksum)
  188.                 else chksum:=chksum+wrd(w^[wx].strx[i])];
  189.            if (q[wx].xfermode and fCrc)<>0 then
  190.              send(chr(hibyte(chksum)));
  191.        send(chr(lobyte(chksum)))]
  192.         else if s_free>10 then
  193.           [j:=s_free-5;
  194.        if j>1024-q[wx].bindex then j:=1024-q[wx].bindex;
  195.            for i:=1 to j do
  196.              [send(q[wx].buffer^.data[q[wx].bindex+i]);
  197.               crc_16(q[wx].buffer^.data[q[wx].bindex+i],q[wx].crc)];
  198.        q[wx].bindex:=q[wx].bindex+j;
  199.        if q[wx].bindex=1024 then
  200.              [send(chr(hibyte(q[wx].crc)));
  201.               send(chr(lobyte(q[wx].crc)))]
  202.            else
  203.              next_state2:=8]
  204.     else
  205.           next_state2:=8;
  206. {when packet completely sent, purge the input buffer}
  207.     9 : if (q[wx].xfermode and fNak)<>0 then
  208.           [if (q[wx].xfermode and f128)<>0
  209.              then q[wx].count4 := q[wx].count4 +  128
  210.              else q[wx].count4 := q[wx].count4 + 1024;
  211.        next_state2:=6]
  212.         else if s_working>0 then
  213.           [while r_count>0 do eval(receive);
  214.            next_state2:=9]
  215.         else
  216.           w^[wx].clock_target:=jt;
  217. {wait for response to packet}
  218.     10 : [i4:=jt-w^[wx].clock_target;
  219.           if i4<0 then i4:=i4+one_day;
  220.           if i4>60 then
  221.             [q[wx].flag:=false; q[wx].count:=0; next_state2:=665]
  222.           else if r_count=0 then
  223.             next_state2:=10];
  224. {looking for an ack}
  225.     11 : case receive of
  226.            can : [q[wx].flag:=false; q[wx].count:=0; next_state2:=665];
  227.            ack : [if (q[wx].xfermode and f128)<>0
  228.                     then q[wx].count4:=q[wx].count4+128
  229.                     else q[wx].count4:=q[wx].count4+1024;
  230.                   next_state2:=6];
  231.            nak : next_state2:=7;
  232.            otherwise next_state2:=10;
  233.          end {case};
  234. {finish up}
  235.     665 : [if q[wx].handle>0 then
  236.              mail_close(q[wx].handle);
  237.            q[wx].handle:=0;
  238.            if w^[wx].file_locked<>nill then w^[wx].file_locked^.msg:=null;
  239.            binary_mode(0); w^[wx].strx:=null];
  240.   end {case};
  241.   q[wx].state2:=next_state2;
  242. end {xtransmit};
  243.  
  244. {